home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / stTypes.c < prev    next >
C/C++ Source or Header  |  1995-09-12  |  11KB  |  389 lines
  1. /*
  2.  *    tclStruct package
  3.  *  Support 'C' structures in Tcl
  4.  *
  5.  *  Written by Matthew Costello
  6.  *  (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  7.  *
  8.  *  See the file "license.terms" for information on usage and
  9.  *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  */
  11. #include "stInternal.h"
  12. STRUCT_SCCSID("@(#)tclStruct:stTypes.c    1.2    95/09/12")
  13.  
  14.  
  15. /*******************************************************************/
  16. #ifdef DEBUG
  17. CONST char *
  18. Struct_TypeName(type)
  19.   Struct_TypeDef *type;
  20. {
  21.     static char namebuf[128];
  22.     if (type->name != NULL)
  23.       sprintf(namebuf,"%.32s(r=%d, s=%d, f=%03o%s, t=%p)",
  24.     type->name,
  25.     type->refcount,
  26.     type->size,
  27.     type->flags,
  28.     (type->flags & STRUCT_FLAG_IS_ARRAY) ? " A" :
  29.       (type->flags & STRUCT_FLAG_IS_STRUCT) ? " S" :
  30.         (type->flags & STRUCT_FLAG_IS_POINTER) ? " P" : "",
  31.     (void *)type->TraceProc );
  32.     else
  33.       sprintf(namebuf,"anon%p(r=%d, s=%d, f=%03o%s, t=%p)",
  34.     (void *)type,
  35.     type->refcount,
  36.     type->size,
  37.     type->flags,
  38.     (type->flags & STRUCT_FLAG_IS_ARRAY) ? " A" :
  39.       (type->flags & STRUCT_FLAG_IS_STRUCT) ? " S" :
  40.         (type->flags & STRUCT_FLAG_IS_POINTER) ? " P" : "",
  41.     (void *)type->TraceProc );
  42.     return namebuf;
  43. }
  44. #endif
  45.  
  46. /*  Create a new type.  This type may, or may not, be registered
  47.  *  with a name.  We use anonymous types for arrays.
  48.  *  ALL types are created here.
  49.  */
  50. /*ARGSUSED*/
  51. Struct_TypeDef *
  52. Struct_NewType( cdata, interp, typename, size, flags, traceProc )
  53.   ClientData cdata;
  54.   Tcl_Interp *interp;
  55.   CONST char *typename;
  56.   int size;
  57.   int flags;
  58.   Tcl_VarTraceProc *traceProc;
  59. {
  60.     Struct_TypeDef *type;
  61.  
  62. #ifdef DEBUG
  63.     if (struct_debug & DBG_NEWTYPE)
  64.     printf("Struct_NewType( name = \"%s\", size = %d, flags = %03o, trace = %p\n",
  65.     typename ? typename : "<none>", size, flags, (void *)traceProc );
  66. #endif
  67.     type = (Struct_TypeDef *)ckalloc(sizeof(Struct_TypeDef));
  68.     if (type == NULL) {
  69.         if (interp != NULL)
  70.         Tcl_SetResult(interp,"Can't allocate type structure object!",TCL_STATIC);
  71.         return NULL;
  72.     }
  73.     Struct_PkgInfo(cdata,si_nNewTypes) += 1;
  74.     memset( (char *)type, 0x00, sizeof(Struct_TypeDef) );
  75. #ifdef STRUCT_MAGIC
  76.     type->magic = STRUCT_MAGIC_TYPE;
  77. #endif
  78.     if (typename != NULL)
  79.     type->name = strdup( typename );
  80.     type->refcount = 1;
  81.     type->size = size;
  82.     type->flags = flags;
  83.     if (type->flags & STRUCT_FLAG_ALIGN_SIZE)
  84.     type->align = size;
  85.     else
  86.     type->align = 1;
  87.     type->TraceProc = traceProc;
  88. #ifdef DEBUG
  89.     if (struct_debug & (DBG_NEWTYPE|DBG_REFCOUNT))
  90.     printf("Struct_NewType() = %p  %s\n", (void *)type, Struct_TypeName(type) );
  91. #endif
  92.     return type;
  93. }
  94.  
  95. Struct_TypeDef *
  96. Struct_CloneType( cdata, interp, typename, type )
  97.   ClientData cdata;
  98.   Tcl_Interp *interp;
  99.   CONST char *typename;
  100.   Struct_TypeDef *type;
  101. {
  102.     Struct_TypeDef *newtype;
  103.     unsigned int size;
  104.     Struct_StructElem *pelem;
  105.     Struct_CheckType(type,"CloneType");
  106. #ifdef DEBUG
  107.     if (struct_debug & (DBG_NEWTYPE))
  108.     printf("Struct_CloneType: cloning %s\n", Struct_TypeName(type) );
  109. #endif
  110.     newtype = Struct_NewType( cdata, interp, typename,
  111.         type->size, type->flags, type->TraceProc );
  112.     if (type->fill != NULL)
  113.     newtype->fill = strdup(type->fill);
  114.     newtype->align = type->align;
  115.  
  116.     switch (type->flags & STRUCT_FLAG_IS_MASK) {
  117.       case STRUCT_FLAG_IS_STRUCT:
  118.     /* Need to copy the list of structures as well.  */
  119. #ifdef DEBUG
  120.     if (struct_debug & (DBG_NEWTYPE))
  121.     printf("Struct_CloneType: structure has %d members\n",
  122.         type->u.s.num_elements );
  123. #endif
  124.     size = (type->u.s.num_elements + 1) * sizeof(Struct_StructElem);
  125.     if ((newtype->u.s.struct_def = (Struct_StructElem *)ckalloc(size)) == NULL) {
  126.         Tcl_SetResult(interp,"Can't allocate structure member definition!",TCL_STATIC);
  127.         return NULL;
  128.     }
  129.     memcpy( (char *)newtype->u.s.struct_def,
  130.             (char *)type->u.s.struct_def, size );
  131.     newtype->u.s.num_elements = type->u.s.num_elements;
  132.     for ( pelem = newtype->u.s.struct_def; pelem->type != NULL; pelem++ ) {
  133.         Struct_AttachType( pelem->type );
  134.         if (pelem->name)
  135.             pelem->name = strdup(pelem->name);
  136.     }
  137.     break;
  138.      case STRUCT_FLAG_IS_ARRAY:
  139.      case STRUCT_FLAG_IS_POINTER:
  140.      case STRUCT_FLAG_IS_ADDR:
  141.     newtype->u.a.array_elem = type->u.a.array_elem;
  142.     Struct_AttachType( newtype->u.a.array_elem );
  143.     break;
  144.     }
  145.  
  146.     Struct_ReleaseType(type);
  147.     return newtype;
  148. }
  149.  
  150. Struct_TypeDef *
  151. Struct_DefArray(cdata, interp, elemtype, nelem)
  152.   ClientData cdata;
  153.   Tcl_Interp *interp;
  154.   Struct_TypeDef *elemtype;
  155.   int nelem;
  156. {
  157.     Struct_TypeDef *type;
  158.     int size;
  159.     int flags;
  160.     Struct_CheckType(elemtype,"DefArray");
  161. #ifdef DEBUG
  162.     if (struct_debug & (DBG_NEWTYPE))
  163.     printf("Struct_DefArray( elem = %s, nelem = %d )\n",
  164.     Struct_TypeName(elemtype), nelem );
  165. #endif
  166.     if (nelem < 0) {
  167.     Tcl_ResetResult(interp);
  168.     sprintf(interp->result,"negative array size of %d is illegal",nelem);
  169.     return NULL;
  170.     }
  171.     size = nelem * elemtype->size;
  172.     if (nelem == 0)
  173.     flags = STRUCT_FLAG_IS_ARRAY|STRUCT_FLAG_USE_STRICT|STRUCT_FLAG_VARLEN;
  174.     else
  175.         flags = STRUCT_FLAG_IS_ARRAY|STRUCT_FLAG_USE_STRICT|STRUCT_FLAG_STRICT;
  176.     if ((type = Struct_NewType( cdata, interp, (char *)NULL, size,
  177.         flags, NULL )) == NULL)
  178.         return NULL;
  179.     Struct_AttachType(elemtype);
  180.     type->u.a.array_elem = elemtype;
  181.     type->align = elemtype->align;
  182.     if (elemtype->flags & STRUCT_FLAG_TRACE_ARRAY) {
  183.     type->TraceProc = elemtype->TraceProc;
  184.     type->flags |= STRUCT_FLAG_TRACE_BASIC;
  185.     } else
  186.     type->TraceProc = Struct_TraceArray;
  187. #ifdef DEBUG
  188.     if ( (struct_debug & (DBG_NEWTYPE)) ||
  189.          ((nelem == 0) && (struct_debug & DBG_VARLEN)) )
  190.     printf("Struct_DefArray() = %p  %s\n", (void *)type, Struct_TypeName(type) );
  191. #endif
  192.     return type;
  193. }
  194.  
  195. Struct_TypeDef *
  196. Struct_InstantiateType(cdata, interp, typename, basetype, nelem )
  197.   ClientData cdata;
  198.   Tcl_Interp *interp;
  199.   CONST char *typename;
  200.   Struct_TypeDef *basetype;
  201.   int nelem;
  202. {
  203.     Struct_TypeDef *type;
  204.     unsigned long oldsize;
  205.     Struct_CheckType(basetype,"InstantiateType");
  206. #ifdef DEBUG
  207.     if (struct_debug & (DBG_VARLEN))
  208.     printf("Struct_InstantiateType( typename = %s, basetype = %s, nelem = %d )\n",
  209.     typename ? typename : "<none>", Struct_TypeName(basetype), nelem );
  210. #endif
  211.     if (!(basetype->flags & STRUCT_FLAG_VARLEN)) {
  212.     Tcl_AppendResult(interp,"not a variable type",
  213.              (char *)NULL );
  214.     return NULL;
  215.     }
  216.     type = Struct_CloneType(cdata, interp, (char *)typename, basetype );
  217.     /* Struct_ReleaseType(basetype); */
  218.     if (type == NULL) {
  219.     return NULL;
  220.     }
  221.  
  222.     type->flags &= ~STRUCT_FLAG_VARLEN;
  223.     switch (type->flags & STRUCT_FLAG_IS_MASK) {
  224.       case STRUCT_FLAG_IS_ARRAY:
  225.     type->flags |= STRUCT_FLAG_STRICT;
  226.     type->size = nelem * type->u.a.array_elem->size;
  227.         break;
  228.       case STRUCT_FLAG_IS_STRUCT:
  229.     oldsize = type->u.s.struct_def[type->u.s.num_elements - 1].type->size;
  230.     type->u.s.struct_def[type->u.s.num_elements - 1].type =
  231.         Struct_InstantiateType(cdata,interp,NULL,
  232.         type->u.s.struct_def[type->u.s.num_elements - 1].type,nelem);
  233.     type->size += (type->u.s.struct_def[type->u.s.num_elements - 1].type->size - oldsize);
  234.     break;
  235.       default:
  236.     Tcl_AppendResult(interp,"Struct_InstantiateType:: not a variable type",
  237.              (char *)NULL );
  238.     return NULL;
  239.     }
  240.  
  241.     /*  Make sure the object has a size that is a multiple of the alignment.
  242.      */
  243.     type->size = (type->size + type->align - 1) / type->align;
  244.     type->size *= type->align;
  245. #ifdef DEBUG
  246.     if (struct_debug & (DBG_VARLEN))
  247.     printf("Struct_InstantiateType() = %s\n", Struct_TypeName(type) );
  248. #endif
  249.     return type;
  250. }
  251.  
  252. /*  Register a new type.
  253.  *  Both simple types (e.g. "int") and structures
  254.  *  are defined here.
  255.  */
  256. int
  257. Struct_RegisterType(cdata, interp, typename, type)
  258.   ClientData cdata;
  259.   Tcl_Interp *interp;
  260.   CONST char *typename;
  261.   Struct_TypeDef *type;
  262. {
  263.     Tcl_HashEntry *entryPtr;
  264.     int new;
  265.  
  266.     if (typename == NULL)
  267.     return TCL_OK;
  268.     if (type == NULL) {
  269.     Tcl_AppendResult(interp,"null type for \"",typename,"\"",
  270.              (char *)NULL );
  271.     return TCL_ERROR;
  272.     }
  273.     Struct_CheckType(type,"RegisterType");
  274.     entryPtr=Tcl_CreateHashEntry(Struct_TypeHash(cdata),(char *)typename,&new);
  275.     if (!new) {
  276.     Tcl_AppendResult(interp,"name \"",typename,"\" already allocated",
  277.              (char *)NULL );
  278.     return TCL_ERROR;
  279.     }
  280.     Struct_AttachType(type);    /* It should stay around forever */
  281.     if (type->name == NULL)
  282.     type->name = strdup( typename );
  283.  
  284.     Tcl_SetHashValue(entryPtr,type);
  285.     return TCL_OK;
  286. }
  287. int
  288. Struct_RegisterBuiltInType(cdata, interp, typename, size,flags,traceProc)
  289.   ClientData cdata;
  290.   Tcl_Interp *interp;
  291.   CONST char *typename;
  292.   int size;
  293.   int flags;
  294.   Tcl_VarTraceProc *traceProc;
  295. {
  296.     Struct_TypeDef *type;
  297.     if ((type = Struct_NewType(cdata,interp,typename,size,
  298.         flags|STRUCT_FLAG_BUILTIN|STRUCT_FLAG_TRACE_BASIC,
  299.         traceProc)) == NULL)
  300.     return TCL_ERROR;
  301.     if (Struct_RegisterType(cdata,interp,typename,type) == TCL_ERROR) {
  302.     Struct_ReleaseType(type);
  303.     return TCL_ERROR;
  304.     }
  305.     return TCL_OK;
  306. }
  307.  
  308.  
  309. /*
  310.  * Struct_AttachType
  311.  * Struct_ReleaseType
  312.  *
  313.  *    Attach a type by incrementing its reference count.
  314.  *    Release a type by decrementing its reference count.
  315.  *
  316.  *    This is done so that types may be freed up when the
  317.  *    last reference to a type has gone.  The built-in
  318.  *    types have a reference count of two (2) to prevent
  319.  *    them from being untypedef'd.
  320.  *
  321.  *    When a type's reference count goes to zero it is freed
  322.  *    up after first decrementing the reference counts of
  323.  *    any types that it references.
  324.  */
  325. void
  326. Struct_AttachType(type)
  327.   Struct_TypeDef *type;
  328. {
  329.     if (type == NULL)
  330.     return;
  331.     Struct_CheckType(type,"AttachType");
  332. #ifdef DEBUG
  333.     if (struct_debug & (DBG_REFCOUNT))
  334.     printf("Struct_AttachType: attaching %s\n", Struct_TypeName(type) );
  335. #endif
  336.     type->refcount++;
  337. }
  338.  
  339. void
  340. Struct_ReleaseType(type)
  341.   Struct_TypeDef *type;
  342. {
  343.     Struct_StructElem *pelem;
  344.     if (type == NULL)
  345.     return;
  346.     Struct_CheckType(type,"ReleaseType");
  347.     if (--type->refcount > 0) {
  348. #ifdef DEBUG
  349.     if (struct_debug & (DBG_REFCOUNT))
  350.     printf("Struct_ReleaseType: keeping %s\n", Struct_TypeName(type) );
  351. #endif
  352.     return;
  353.     }
  354. #ifdef DEBUG
  355.     if (type->refcount < 0)
  356.     panic("ERROR: negative type refcount on %s\n", Struct_TypeName(type) );
  357.     if (struct_debug & (DBG_REFCOUNT|DBG_NEWTYPE))
  358.     printf("Struct_ReleaseType: freeing %s\n", Struct_TypeName(type) );
  359. #endif
  360. #ifdef ACCESS_TO_INTERPRETER
  361.     Struct_PkgInfo(cdata,si_nExTypes) += 1;
  362. #endif
  363.  
  364.     /* Special processing for different kinds of types */
  365.     switch (type->flags & STRUCT_FLAG_IS_MASK) {
  366.       case STRUCT_FLAG_IS_ARRAY:
  367.       case STRUCT_FLAG_IS_POINTER:
  368.       case STRUCT_FLAG_IS_ADDR:
  369.     if (!(type->flags & STRUCT_FLAG_RECURSIVE))
  370.         Struct_ReleaseType( type->u.a.array_elem );
  371.     break;
  372.       case STRUCT_FLAG_IS_STRUCT:
  373.     for ( pelem = type->u.s.struct_def; pelem->type != NULL; pelem++ ) {
  374. #ifndef STRUCT_NOFREE
  375.         if (pelem->name != NULL)
  376.         ckfree( pelem->name );
  377. #endif
  378.         Struct_ReleaseType( pelem->type );
  379.     }
  380. #ifndef STRUCT_NOFREE
  381.     ckfree( type->u.s.struct_def );
  382. #endif
  383.     }
  384.  
  385. #ifndef STRUCT_NOFREE
  386.     ckfree( type );
  387. #endif
  388. }
  389.